perm filename TICTAC.LSP[206,JMC]1 blob sn#070525 filedate 1973-11-11 generic text, type T, neo UTF8
00100	(SETQ TICTACFNS @(
00200	TER
00300	IMVAL
00400	SUCCESSORS
00500	REVERT
00600	UPDATE
00700	DELETE
00800	CONTAINED
00900	PTS
01000	LINES
01100	))
01200	
01300	(SETQ PTS @((1 4 7) (1 5) (1 6 10) (2 4) (2 5 7 10) (2 6)
01400	(3 4 10) (3 5) (3 6 7)))
01500	
01600	(SETQ LINES @((1 2 3) (4 5 6)(7 10 11) (1 4 7) (2 5 10)
01700	(3 5 11) (1 5 11) (3 5 7)))
01800	
01900	(DE TER (P ALPHA BETA) (OR (EQUAL (LENGTH P) 11)
02000	(ORLIS (FUNCTION (LAMBDA (X) (CONTAINED X (COND
02100	(W XS)(T OS))))) (CAR (NTH LINES (CAR P))))))
02200	
02300	(DE IMVAL (P ALPHA BETA) (COND ((ORLIS (FUNCTION
02400	(LAMBDA (X) (CONTAINED X (COND (W XS) (T OS)))))
02500	(CAR (NTH LINES (CAR P)))) (COND ((W 1) (T -1)))
02600	(T 0)))
02700	
02800	(DE SUCCESSORS (P) (MAPCAR (FUNCTION (LAMBDA (X)
02900	(CONS X P))) BS))
03000	
03100	(DE REVERT () (PROG NIL
03200	(SETQ BS (CONS (CAR (COND (W XS) (T OS))) BS))
03300	(COND (W (SETQ XS (CDR XS))) (T (SETQ OS (CDR OS))))
03400	(SETQ W (NOT W))
03500	(RETURN NIL)
03600	))
03700	
03800	(DE UPDATE (M) (PROG NIL
03900	(COND (W (SETQ OS (CONS (CAR M) OS))) (T (SETQ XS (CONS (CAR M) XS))))
04000	(SETQ BS (DELETE (CAR M) BS)
04100	(SETQ W (NOT W))
04200	(RETURN NIL)
04300	))
04400	
04500	(DE DELETE (X U) (COND ((NULL U) NIL) ((EQUAL X (CAR U)) (CDR U))
04600	(T (CONS (CAR U) (DELETE X (CDR U))))))
04700	
04800	(DE CONTAINED (U V) (ANDLIS (FUNCTION (LAMBDA (X) (MEMBER X V))) U))